home *** CD-ROM | disk | FTP | other *** search
/ ASP Advantage 1993 / The Association of Shareware Professionals Advantage CD-ROM 1993.iso / files / commions / ca29_1 / ca29_3.exe / BBMAINT1.CMD < prev    next >
OS/2 REXX Batch file  |  1992-03-24  |  20KB  |  759 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS UserID maintenance script (User file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT1.CMD, produces the main window for
  8. ;    UserID functions of BBMAINT, and implements its functions.  It
  9. ;    is not directly callable itself.
  10. ; -----------------------------------------------------------------------
  11. ;    Usage:
  12. ;       N99 -> Text attribute value (setup by BBMAINT.CMD)
  13. ;       N98 -> BBMAINT Mainline cursor position
  14. ;       N97 -> BBMAINT Mainline cursor position
  15. ;       N96 -> our mainline cursor position
  16. ;       N95 -> our mainline cursor position
  17. ; -----------------------------------------------------------------------
  18. ;
  19. ;    This script is intended ONLY to be used for FCALL
  20. ;
  21.     IF NOT FCALLED
  22.        WOPEN 10,10,13,70 (cont) NOUSEsc
  23.        ATSAY 10,12 (cont) " BBS Users "
  24.        ATSAY 11,12 (cont) " The script: "*"_SCRIPT"
  25.        ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT"
  26.        ATSAY 13,26 (cont) " Press any key to continue "
  27.        KEYGET S0        ; Wait for any key
  28.        WCLOSE        ; Close open window
  29.        EXIT         ; Terminate right here
  30.        ENDIF
  31.  
  32.     GOSUB UserFile        ; Invoke function
  33.     FRETURN         ; Return to caller
  34. ; -----------------------------------------------------------------------
  35. ; ----- NoUser:  Inform that there's no USER ID file to modify
  36. ;
  37. NoUser:
  38.     WOPEN 10,10,13,70 (cont) NOUSEsc
  39.     ATSAY 10,12 (cont) " BBS User "
  40.     ATSAY 11,12 (cont) " The file: "*S22&"\BBS-User"
  41.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  42.     ATSAY 13,26 (cont) " Press any key to continue "
  43.     ;
  44.     ;    Wait a keypress
  45.     ;
  46.     KEYGET S0        ; Wait for any key
  47.     WCLOSE
  48. NOUSEsc:
  49.     RETURN
  50. ; -----------------------------------------------------------------------
  51. ; ----- Subroutine: UserFile -> Update user ID directory
  52. ;
  53. UserFile:
  54.     GOSUB NewUser        ; Create if not there
  55.     IF NOT ISFILE S22&"\BBS-USER"
  56.        GOSUB NoUser     ; Inform there's no file
  57.        RETURN        ; .. so we can't continue
  58.        ENDIF
  59. ;
  60. ;    Open a window
  61. ;
  62.     WOPEN 0,0 23,79 (defa) User_Esc
  63.     ATSAY 0,2 (defa)   " BBS Users "
  64.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  65. ;
  66. ;    Paint the menu
  67. ;
  68. USFI100:
  69.     CLEAR            ; Clear window
  70.     LOCATE 2,2
  71.  
  72.     MESS " 1) Add an ID"
  73.     MESS " 2) Delete an ID"
  74.     MESS " 3) Modify an ID's values"
  75.     MESS " 4) Print User list"
  76.     MESS " 5) View list of IDs"
  77.     MESS "──────────────────────────────────── "
  78.     MESS "Note: Alt-Q to edit a file"
  79.     MESS "      Alt-F for a directory search"
  80.     MESS "      Alt-F10 to shell to DOS"
  81.     MESS " "
  82.     MESS "──────────────────────────────────── "
  83.     MESS " "
  84.     MESS "Select item (carriage return = previous): "
  85.     CURSOR N96,N95        ; Read current cursor
  86. ;
  87. ;    Wait for entry, and interpret
  88. ;
  89. USFI200:
  90.     LOCATE N96 N95        ; Reposition cursor
  91.     KEYGET S0        ; Wait for it
  92.     SWITCH S0        ; Act according to keyget
  93.       CASE "1"
  94.            GOSUB AddID
  95.            ENDCASE
  96.       CASE "2"
  97.            GOSUB DelID
  98.            ENDCASE
  99.       CASE "3"
  100.            GOSUB ModID
  101.            ENDCASE
  102.       CASE "4"
  103.            GOSUB PrnID
  104.            ENDCASE
  105.       CASE "5"
  106.            GOSUB ViewID
  107.            GOTO USFI100    ; Repaint after this
  108.            ENDCASE
  109.       CASE "0d"             ; c/r alone is exit
  110.            WCLOSE        ; Close window...
  111.            RETURN        ; and return to caller
  112.            ENDCASE
  113.       CASE "_NULL"          ; ESC -> Null
  114.            WCLOSE        ; Close window...
  115.            RETURN        ; Leave Main routine
  116.            ENDCASE
  117.       CASE "2100"           ; Alt-F
  118.            MANUAL "0x2100"  ; Perform Dir cmd
  119.            ENDCASE
  120.       CASE "1000"           ; Alt-Q
  121.            MANUAL "0x1000"  ; Edit a file
  122.            ENDCASE
  123.       CASE "7100"           ; Alt-F10
  124.            SHELL
  125.            DWINDOW 1,2,22,78; Reset dwindow after shell
  126.            LEGEND "_LEGEND" ; Redo the legend
  127.            ENDCASE
  128.       DEFAULT        ; None of the above
  129.            SOUND 100,100    ; Bronx cheer
  130.            ENDCASE
  131.       ENDSWITCH
  132.     GOTO USFI200        ; Repaint screen and ask again
  133. ;
  134. ;    End of Users procedure
  135. ;
  136. User_Esc:
  137.     S0 = ""                 ; Fake a nulll entry
  138.     RETURN            ; Leave users routine
  139. ; -----------------------------------------------------------------------
  140. ; ----- AddID:    Add an ID to the User file
  141. ;
  142. AddID:
  143.     SET FLAG(0) OFF     ; Flag for ESCAPE
  144.     WOPEN 10,10,15,70 (cont) ADIDEsc
  145.     ATSAY 10,12 (cont) " BBS User Add "
  146.     ATSAY 11,12 (cont) "Enter the ID to be added: "
  147.     ATSAY 15,26 (cont) " Press ESC to cancel "
  148.     ;
  149.     ;    Wait a keypress
  150.     ;
  151.     LOCATE 11,38
  152.     GET S0 8        ; get ID
  153.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  154.     LJ S0            ; Left justify
  155.     UPPER S0        ; ... and upper case
  156.     IF NULL S0 GOTO ADIDEnd ; get out on empty entry
  157.     GOSUB LkpID        ; Lookup ID in User file
  158.     IF FOUND        ; If its there we can't add it
  159.        WCLOSE        ; Close open window
  160.        GOTO ModID_Add    ; Skip if ID found
  161.        ENDIF
  162.     S10 = S0        ; Save ID
  163.     GOTO ADID100        ; And branch around parallel code
  164. ;
  165. ;    Entry from ModID... Nothing to modify
  166. ;
  167. AddID_Mod:
  168.     WOPEN 10,10,15,70 (cont) ADIDEsc
  169.     ATSAY 10,12 (cont) " BBS User Add "
  170.     ATSAY 11,12 (cont) "Enter the ID to be added: "
  171.     ATSAY 11,38 (cont) S0
  172.     ATSAY 15,26 (cont) " Press ESC to cancel "
  173.     S10 = S0        ; Copy it for remainder
  174. ;
  175. ;    Ask for a password
  176. ;
  177. ADID100:
  178.     ATSAY 12,12 (cont) "Enter the password:       "
  179.     LOCATE 12,38
  180.     GET S0 8        ; get resp
  181.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  182.     LJ S0            ; Left justify
  183.     UPPER S0        ; ... and upper case
  184.     IF NULL S0        ; Password MUST be filled in
  185.        SOUND 100,100    ; Indicate displeasure
  186.        GOTO ADID100     ; Try again
  187.        ENDIF
  188.     S10(8:15) = S0        ; Save password
  189. ;
  190. ;    Ask for privileged flag
  191. ;
  192. ADID200:
  193.     ATSAY 13,12 (cont) "Priveleged access (y/n):  "
  194.     LOCATE 13,38
  195.     GET S0 1        ; get resp
  196.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  197.     IF NULL S0 or NOT FIND "YN" S0(0)
  198.        SOUND 100,100    ; Indicate displeasure
  199.        GOTO ADID200     ; Try again
  200.        ENDIF
  201.     IF FIND "Y" S0(0) S10(16:16) = "P" ; Save priveleged access
  202. ;
  203. ;    Ask for one more look
  204. ;
  205. ADID300:
  206.     ATSAY 14,12 (cont) "OK to add this record?:   "
  207.     LOCATE 14,38
  208.     GET S0 1        ; get resp
  209.     IF FLAG(0) GOTO ADIDEnd ; Exit if ESC hit
  210.     IF NULL S0 or NOT FIND "YN" S0(0)
  211.        SOUND 100,100    ; Indicate displeasure
  212.        GOTO ADID300     ; Try again
  213.        ENDIF
  214.     IF FIND "N" S0(0)
  215.        WCLOSE        ; Close window
  216.        GOTO AddID        ; And try again
  217.        ENDIF
  218. ;
  219. ;    Add comments and write the record
  220. ;
  221.     S10(17:70) = "* Added "*"_DATE"*", at "*"_TIME"
  222.     GOSUB AddUser        ; Write to User file
  223. ;
  224. ;    End of add procedure
  225. ;
  226. ADIDEnd:
  227.     WCLOSE
  228. ADIDEsc:
  229.     SET FLAG(0) ON
  230.     RETURN
  231. ;
  232. ; ----- AddUser:  Add a record to the user file...
  233. ;    .. S10 passes the record to be written
  234. ;
  235. AddUser:
  236.     FOPENO S22&"\BBS-User" TEXT APPEND
  237.     IF NOT SUCCESS        ; Open failed
  238.        S0 = "Error opening: "*S22&"\BBS-User"
  239.        GOSUB Error        ; Report
  240.        RETURN        ; And we're done
  241.        ENDIF
  242.     PRESERVE S10        ; Preserve ^'s and !'s
  243.     WRITE S10        ; Write the record
  244.     WRITE "!^Z"             ; And finish it
  245.     FCLOSEO
  246.     RETURN
  247. ; -----------------------------------------------------------------------
  248. ; ----- LkpID:    Lookup an ID in the BBS-User file
  249. ;    .. S0 passes the ID to be tested
  250. ;    .. S10 returns the record read
  251. ;
  252. LkpID:
  253.     FOPENI S22&"\BBS-User" TEXT
  254.     IF NOT SUCCESS        ; Open failed
  255.        S0 = "Error opening: "*S22&"\BBS-User"
  256.        GOSUB Error        ; Report
  257.        SET FOUND OFF    ; Not found
  258.        RETURN        ; And we're done
  259.        ENDIF
  260. ;
  261. ;    Read loop
  262. ;
  263. LOID100:
  264.     READ S10 80 N0        ; Read a record
  265.     IF EOF GOTO LOID200    ; Skip on EOF
  266.     IF STRCMP S10(0:0) "<" GOTO LOID110
  267.     IF STRCMP S10(0:7) S0(0:7) GOTO LOID300
  268. ;
  269. ;    Record longer than 80 chars
  270. ;
  271. LOID110:
  272.     IF N0 LT 80 GOTO LOID100; If exactly 80 rtnd, c/r wasn't read
  273.     READ S10 80 N0        ; Read remainder of rec
  274.     GOTO LOID110        ; Read until less than 80
  275. ;
  276. ;    We have end-of-file - not found
  277. ;
  278. LOID200:
  279.     SET FOUND OFF        ; Indicate not found
  280.     GOTO LOIDEnd
  281. ;
  282. ;    We have a hit - return found
  283. ;
  284. LOID300:
  285.     SET FOUND ON        ; Indicate found
  286. ;
  287. ;    And exit
  288. ;
  289. LOIDEnd:
  290.     FCLOSEI
  291.     RETURN
  292. ; -----------------------------------------------------------------------
  293. ; ----- DelID:    Delete an ID from User file
  294. ;
  295. DelID:
  296.     SET FLAG(0) OFF     ; Flag for ESCAPE
  297.     WOPEN 10,10,15,70 (cont) DEIDEsc
  298.     ATSAY 10,12 (cont) " BBS User Delete "
  299.     ATSAY 11,12 (cont) "Enter the ID to be deleted: "
  300.     ATSAY 15,26 (cont) " Press ESC to cancel "
  301.     ;
  302.     ;    Wait a keypress
  303.     ;
  304.     LOCATE 11,40
  305.     GET S0 8        ; get ID
  306.     IF FLAG(0) GOTO DEIDEnd ; Exit if ESC hit
  307.     LJ S0            ; Left justify
  308.     UPPER S0        ; ... and upper case
  309.     IF NULL S0 GOTO DEIDEnd ; get out on empty entry
  310. ;
  311. ;    Open the User file and a temp copy file
  312. ;
  313.     GOSUB DelUser        ; Try to delete
  314.     IF FLAG(1) GOTO DEIDEnd ; Skip if record deleted
  315.     ATSAY 12,12 (cont) "ID could not be found... "
  316.     ATSAY 13,12 (cont) "Press any key to continue..."
  317.     KEYGET S0
  318. ;
  319. ;    End of add procedure
  320. ;
  321. DEIDEnd:
  322.     WCLOSE
  323. DEIDEsc:
  324.     SET FLAG(0) ON
  325.     RETURN
  326. ; -----------------------------------------------------------------------
  327. ; ----- DelUser:  Delete a record from the user file...
  328. ;    .. S0 passes the user-id
  329. ;    .. S1 destroyed in the process
  330. ;    .. FLAG(1) if rtn'd set, indicates record was FOUND
  331. ;
  332. DelUser:
  333. ;
  334. ;    Open the User file and a temp copy file
  335. ;
  336.     SET FLAG(1)  OFF    ; Initialize for found flag
  337.     FOPENI S22&"\BBS-User" TEXT
  338.     IF NOT SUCCESS        ; Open failed
  339.        S0 = "Error opening: "*S22&"\BBS-User"
  340.        GOSUB Error        ; Report
  341.        GOTO DEUSEnd     ; And we're done
  342.        ENDIF
  343.  
  344.     FOPENO S22&"\TempUser" TEXT
  345.     IF NOT SUCCESS        ; Open failed
  346.        S0 = "Error opening: "*S22&"\TempUser"
  347.        GOSUB Error        ; Report
  348.        GOTO DEUSEnd     ; And we're done
  349.        ENDIF
  350.     N10 = 0         ; Count recs output for file delete
  351. ;
  352. ;    Read records (40 chars at a time to allow PRESERVE)
  353. ;
  354. DEUS100:
  355.     READ S1 40 N0        ; Read 1st 40 chars
  356.     IF EOF GOTO DEUS300    ; Skip on EOF
  357.     IF ZERO N0 GOTO DEUS100 ; Don't copy blank lines
  358.     IF STRCMP S1(0:7) S0(0:7) GOTO DEUS200
  359.     INC N10         ; Count rec written
  360. ;
  361. ;    Copy the record read to the output file
  362. ;
  363. DEUS110:
  364.     PRESERVE S1        ; Save !'s and ^'s
  365.     WRITE S1        ; Write text
  366.  
  367.     IF N0 LT 40        ; If we wrote end of record
  368.        WRITE "!"            ; Finish w/cr/lf
  369.        GOTO DEUS100     ; And continue copying
  370.        ENDIF
  371.     READ S1 40 N0        ; Read remainder of rec
  372.     IF NOT EOF GOTO DEUS110 ; Skip if not eof
  373.     WRITE "!"               ; Finish record
  374.     GOTO DEUS300        ; End of file
  375. ;
  376. ;    We have a hit
  377. ;
  378. DEUS200:
  379.     SET FLAG(1) ON        ; Flag we deleted item
  380.     IF N0 LT 40 GOTO DEUS100
  381.     READ S1 40 N0        ; Read remainder of rec
  382.     IF NOT EOF GOTO DEUS200 ; Skip if not found
  383. ;
  384. ;    We hit EOF - may or may not have found the target rec
  385. ;
  386. DEUS300:
  387.     IF NOT FLAG(1) GOTO DEUS400 ; skip if not found
  388.     WRITE "^Z"              ; Finish ASCII file
  389.     FCLOSEO         ; Close output
  390.     FCLOSEI         ; Close input
  391.     DELETE S22&"\BBS-User"  ; Delete original
  392.     RENAME S22&"\TempUser" S22&"\BBS-User"
  393.     IF ZERO N10 DELETE S22&"\BBS-User" ; Delete empty file
  394.     GOTO DEUSEnd
  395. ;
  396. ;    We hit EOF - we did not find the record
  397. ;
  398. DEUS400:
  399.     FCLOSEO         ; Close output
  400.     FCLOSEI         ; Close input
  401.     DELETE S22&"\TempUser"  ; Delete copy file
  402. ;
  403. ;    End of procedure...
  404. ;
  405. DEUSEnd:
  406.     RETURN
  407. ; -----------------------------------------------------------------------
  408. ; ----- ModID:    Modify an ID in the User file
  409. ;
  410. ModID:
  411.     SET FLAG(0) OFF     ; Flag for ESCAPE
  412.     WOPEN 10,10,15,70 (cont) MOIDEsc
  413.     ATSAY 10,12 (cont) " BBS User Modify "
  414.     ATSAY 11,12 (cont) "Enter the ID to change: "
  415.     ATSAY 15,26 (cont) " Press ESC to cancel "
  416.     ;
  417.     ;    Wait a keypress
  418.     ;
  419.     LOCATE 11,38
  420.     GET S0 8        ; get ID
  421.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  422.     LJ S0            ; Left justify
  423.     UPPER S0        ; ... and upper case
  424.     IF NULL S0 GOTO MOIDEnd ; get out on empty entry
  425.     GOSUB LkpID        ; Lookup ID in User file
  426.     IF NOT FOUND        ; If its there we can't add it
  427.        WCLOSE        ; Close open window
  428.        GOTO AddID_Mod    ; Skip if ID NOT found
  429.        ENDIF
  430.     GOTO MOID100        ; And branch around parallel code
  431. ;
  432. ;    Entry from AddID... We have a rec in S10 - needs adding
  433. ;
  434. ModID_Add:
  435.     WOPEN 10,10,15,70 (cont) MOIDEsc
  436.     ATSAY 10,12 (cont) " BBS User Modify "
  437.     ATSAY 11,12 (cont) "Enter the ID to change: "
  438.     ATSAY 11,38 (cont) S0
  439.     ATSAY 15,26 (cont) " Press ESC to cancel "
  440. ;
  441. ;    Display the original values (rtnd in S10 by LkpID)
  442. ;
  443. MOID100:
  444.     ATSAY 10,49 (cont) " Old vals "
  445.     ATSAY 11,50 (cont) S10(0:7)
  446.     ATSAY 12,50 (cont) S10(8:15)
  447.     IF NOT NULL S10(16:16)
  448.        ATSAY 13,50 (cont) "y"
  449.     ELSE
  450.        ATSAY 13,50 (cont) "n"
  451.        ENDIF
  452. ;
  453. ;    Ask for a password
  454. ;
  455.     ATSAY 12,12 (cont) "Enter the password:       "
  456.     LOCATE 12,38
  457.     GET S0 8        ; get password
  458.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  459.     LJ S0            ; Left justify
  460.     UPPER S0        ; ... and upper case
  461.     IF NULL S0        ; Password c/r simly copies previous
  462.        ATSAY 12,38 (cont) S10(8:15)
  463.        GOTO MOID200     ; No update
  464.        ENDIF
  465.     S10(8:15) = S0        ; Save password
  466. ;
  467. ;    Ask for privileged flag
  468. ;
  469. MOID200:
  470.     ATSAY 13,12 (cont) "Priveleged access (y/n):  "
  471.     LOCATE 13,38
  472.     GET S0 1        ; get resp
  473.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  474.     IF NULL S0 ATSCR 13,50 1 S0 ; Read back previous value
  475.     IF NOT FIND "YN" S0(0)  ; If not y/n
  476.        SOUND 100,100    ; Indicate displeasure
  477.        GOTO MOID200     ; Try again
  478.        ENDIF
  479.     S10(16:16) = " "        ; Default no priv
  480.     IF FIND "Y" S0(0)       ; If privilege 'y'
  481.        S10(16:16) = "P"     ; Set priveleged access
  482.        ENDIF
  483. ;
  484. ;    Ask for one more look
  485. ;
  486. MOID300:
  487.     ATSAY 14,12 (cont) "OK to add this record?:   "
  488.     LOCATE 14,38
  489.     GET S0 1        ; get resp
  490.     IF FLAG(0) GOTO MOIDEnd ; Exit if ESC hit
  491.     IF NULL S0 or NOT FIND "YN" S0(0)
  492.        SOUND 100,100    ; Indicate displeasure
  493.        GOTO MOID300     ; Try again
  494.        ENDIF
  495.     IF FIND "N" S0(0)
  496.        WCLOSE        ; Close window
  497.        GOTO ModID        ; And try again
  498.        ENDIF
  499. ;
  500. ;    Add comments Delete the previous value... and add the new
  501. ;
  502.     S10(17:70) = "* Modified "*"_DATE"*", at "*"_TIME"
  503.     S0 = S10(0:7)        ; Setup ID key
  504.     GOSUB DelUser        ; Delete the previous key
  505.     IF NOT FLAG(1)        ; If not deleted
  506.        S0 = "Error modifying record for: "*S0
  507.        GOSUB Error        ; Report
  508.        GOTO MOIDEnd     ; And we're done
  509.        ENDIF
  510.     GOSUB AddUser        ; And add the new record
  511. ;
  512. ;    End of add procedure
  513. ;
  514. MOIDEnd:
  515.     WCLOSE
  516. MOIDEsc:
  517.     SET FLAG(0) ON
  518.     RETURN
  519. ; -----------------------------------------------------------------------
  520. ; ----- PrnID:    Print a list of IDs
  521. ;
  522. PrnID:
  523.     FOPENI S22&"\BBS-User" TEXT
  524.     IF NOT SUCCESS        ; Open failed
  525.        S0 = "Error opening: "*S22&"\BBS-User"
  526.        GOSUB Error        ; Report
  527.        RETURN        ; And we're done
  528.        ENDIF
  529. ;
  530. ;    Initialize a counter
  531. ;
  532.     N10 = 0         ; # Lines printed
  533.     N11 = 1         ; Page number
  534. ;
  535. ;    Read loop
  536. ;
  537. PRID100:
  538.     READ S10 80 N0        ; Read a record
  539.     IF EOF GOTO PRID200    ; Skip on EOF
  540.     IF STRCMP S10(0:0) "<" GOTO PRID120 ; skip comments
  541.     IF ZERO N0 GOTO PRID100 ; skip blank lines
  542. ;
  543. ;    Print a heading...
  544. ;
  545.     IF N10 GT 0 and N10 LE 50 GOTO PRID110
  546.     PRINT "COM-AND Scripted BBS User list as of "*"_DATE"*", "*"_TIME"*"      Page "*N11*"^M^J"
  547.     PRINT "From: "*"_IFILE"*"^M^J"
  548.     PRINT "----------------------------------------------------------------------^M^J"
  549.     PRINT "ID       Priv Comments^M^J"
  550.     PRINT "-------- ---- --------------------------------------------------------^M^J"
  551.     N10 = 0
  552.     INC N11
  553. ;
  554. ;    Build a record and print it
  555. ;
  556. PRID110:
  557.     S0 = S10(0:7)        ; ID Field
  558.     IF NOT NULL S10(16:16) S0(10:12) = "yes"
  559.     S0(14:79)  = S10(17:79) ; Comment field
  560.     PRESERVE S0
  561.     PRINT S0
  562.     PRINT "^M^J"            ; FInish line
  563.     INC N10         ; COunt lines printed
  564. ;
  565. ;    Handle record longer than 80 chars
  566. ;
  567. PRID120:
  568.     IF N0 LT 80 GOTO PRID100; If exactly 80 rtnd, c/r wasn't read
  569.     READ S10 80 N0        ; Read remainder of rec
  570.     GOTO PRID120        ; Read until less than 80
  571. ;
  572. ;    We have end-of-file
  573. ;
  574. PRID200:
  575.     PRINT "^L"              ; Do a final top-of-form
  576. ;
  577. ;    And exit
  578. ;
  579. PRIDEnd:
  580.     FCLOSEI
  581.     RETURN
  582. ; -----------------------------------------------------------------------
  583. ; ----- ViewID:  View a list of IDs
  584. ;
  585. ViewID:
  586.     FOPENI S22&"\BBS-User" TEXT
  587.     IF NOT SUCCESS        ; Open failed
  588.        S0 = "Error opening: "*S22&"\BBS-User"
  589.        GOSUB Error        ; Report
  590.        RETURN        ; And we're done
  591.        ENDIF
  592. ;
  593. ;    Initialize a counter
  594. ;
  595.     N10 = 0         ; # Lines printed
  596.     N11 = 0         ; Page number
  597.     SET FLAG(0) OFF     ; Initialize esc flag
  598.     S11 = "_ONESC"
  599.     ON ESCAPE GOSUB VIIDESC
  600. ;
  601. ;    Print a heading...
  602. ;
  603. VIID100:
  604.     IF N10 GT 0 GOTO VIID110
  605.     CLEAR            ; Clear the window
  606.     ATSAY 1,2 (defa) "ID       Priv Comments"
  607.     ATSAY 2,2 (defa) "-------- ---- ----------------------------------------------------"
  608.     N10 = 3         ; Set starting line no
  609.     INC N11         ; Set next page
  610. ;
  611. ;    Save the file position for the start of this page
  612. ;
  613.     FSAVEI
  614.     IF NOT SUCCESS
  615.        FSAVEI SHIFT     ; Save last 20 pos'ns
  616.        FSAVEI
  617.        ENDIF
  618. ;
  619. ;    Read loop
  620. ;
  621. VIID110:
  622.     READ S10 80 N0        ; Read a record
  623.     IF EOF GOTO VIID200    ; Skip on EOF
  624.     IF STRCMP S10(0:0) "<" GOTO VIID120 ; skip comments
  625.     IF ZERO N0 GOTO VIID110 ; skip blank lines
  626. ;
  627. ;    Build a record and print it
  628. ;
  629.     S0 = S10(0:7)        ; ID Field
  630.     IF NOT NULL S10(16:16) S0(10:12) = "yes"
  631.     S0(14:75)  = S10(17:79) ; Comment field
  632.     PRESERVE S0
  633.     ATSAY N10,2 (defa) S0
  634.     INC N10         ; COunt lines printed
  635. ;
  636. ;    Handle record longer than 80 chars
  637. ;
  638. VIID120:
  639.     IF N0 LT 80 GOTO VIID200; If exactly 80 rtnd, c/r wasn't read
  640.     READ S10 80 N0        ; Read remainder of rec
  641.     GOTO VIID120        ; Read until less than 80
  642. ;
  643. ;    Look for end of screen/end of file
  644. ;
  645. VIID200:
  646.     IF (NOT EOF) and N10 LT 21 GOTO VIID100
  647.     IF EOF
  648.        ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)"
  649.     ELSE
  650.        ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)"
  651.        ENDIF
  652. ;
  653. ;    Read a key and interpret
  654. ;
  655. VIID210:
  656.     IF FLAG(0) RETURN    ; End of routine when flag set
  657.     KEYGET S1
  658.     IF FLAG(0) RETURN    ; End of routine when flag set
  659.     SWITCH S1
  660.       CASE "4900"           ; Pgup
  661.         GOTO PgUp
  662.         ENDCASE
  663.       CASE "5100"           ; PgDn
  664.         GOTO PgDn
  665.         ENDCASE
  666.       CASE "4700"           ; Home
  667.         GOTO Home
  668.         ENDCASE
  669.       CASE "0D"             ; C/r
  670.         IF EOF GOTO VIIDEnd
  671.         GOTO PgDn
  672.         ENDCASE
  673.       CASE "2100"           ; Alt-F
  674.         MANUAL "0x2100"     ; Perform Dir cmd
  675.         ENDCASE
  676.       CASE "1000"           ; Alt-Q
  677.         MANUAL "0x1000"     ; Edit a file
  678.         ENDCASE
  679.       CASE "7100"           ; Alt-F10
  680.         SHELL
  681.         DWINDOW 1,2,22,78    ; Reset dwindow after shell
  682.         LEGEND "_LEGEND"    ; Redo the legend
  683.         ENDCASE
  684.       DEFAULT
  685.         MESS S1
  686.         SOUND 100,100
  687.         ENDCASE
  688.       ENDSWITCH
  689.     GOTO VIID210
  690. ;
  691. ;    Page up (go backwards)
  692. ;
  693. PgUp:
  694.     N10 = 0         ; Clear line ctr
  695.     FRESTOREI        ; Backup current pg
  696.     N11 = N11-1        ; Reset Page # for redisplay
  697.     FRESTOREI        ; Backup one more
  698.     IF NOT SUCCESS
  699.        SOUND 200,100    ; Indicate problem
  700.        GOTO Home
  701.        ENDIF
  702.     N11 = N11-1        ; Reset Page # for redisplay
  703.     GOTO VIID100
  704. ;
  705. ;    Home (go to top)
  706. ;
  707. Home:
  708.     N10 = 0         ; Clear line ctr
  709.     N11 = 0         ; Set new pg number
  710.     FSAVEI CLEAR        ; Clear saved pages
  711.     REWIND            ; Rewind input
  712.     GOTO VIID100
  713. ;
  714. ;    Page down (go forwards)
  715. ;
  716. PgDn:
  717.     IF EOF GOTO Home    ; Wrap to home at EOF
  718.     N10 = 0         ; Clear line ctr
  719.     GOTO VIID100
  720. ;
  721. ;    And exit
  722. ;
  723. VIIDEnd:
  724.     FCLOSEI
  725.     RETURN
  726. ;
  727. ;    Escape entered
  728. ;
  729. VIIDESC:
  730.     SET FLAG(0) ON
  731.     ON ESCAPE GOSUB S11    ; Restore previous ON ESC
  732.     RETURN
  733. ;--------------------------------------------------------------------------
  734. ; ----- Subroutine: NewUser -> Create a new BBS-User file
  735. ;
  736. NewUser:
  737.     IF ISFILE S22&"\BBS-User" RETURN
  738.     FOPENO S22&"\BBS-User" TEXT
  739.     IF NOT SUCCESS RETURN    ; Open failed
  740.     WRITE "!^Z"             ; Make it empty
  741.     FCLOSEO         ; Done with it
  742.     RETURN
  743. ; -----------------------------------------------------------------------
  744. ; ----- Error:    Open a window, display a message, and wait for keypress
  745. ;    S0 passes the error message
  746. ;
  747. Error:
  748.     WOPEN 10,10,12,70 (cont) Err_Esc
  749.     ATSAY 10,12 (cont) " Error "
  750.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  751.     ATSAY 12,26 (cont) " Press any key to continue "
  752.     ;
  753.     ;    Wait a keypress
  754.     ;
  755.     KEYGET S0        ; Wait for any key
  756.     WCLOSE
  757. Err_Esc:
  758.     RETURN
  759.